home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Loadstar 92
/
092.d81
/
tile basic
(
.txt
)
< prev
next >
Wrap
Commodore BASIC
|
2022-08-26
|
9KB
|
230 lines
100 ifpeek(56)<>144thenpoke56,144:poke46,64:poke45,1:clr
105 dv=peek(186):ifdv<8thendv=8
110 ifa=0thena=1:load"toolbox c000",dv,1
120 ifa=1thena=2:load"tile font",dv,1
130 ifa=2thena=3:load"redraw.o",dv,1
140 ifa=3thena=4:load"getword 9000",dv,1
150 dimdm$(7),gm$(7),tm$(10),c$(16):de=peek(186):ifde<8thende=8
160 fori=1to7:readdm$(i):next:fori=1to7:readgm$(i):next
170 fori=1to4:readtm$(i):next:fori=1to16:readc$(i):next
180 c=15:c2=12:c3=3:c4=14:c5=5:c6=13:c7=7:c8=8:c9=9:ft=14336:bs=40960-720
190 mt=49152:l=mt:poke53272,31:m=8:poke53281,0:poke53280,0:tc=13:gc=14:cc=1:bc=0
200 gosub1220
210 poke646,tc:print" [212][201][204][197][205][197][201][211][212][197][210] by [202]eff [202]ones [221] ^ for [205]enus":sysmt+12
220 sys51456,m,gc,tc
230 sysmt+6,208:poke646,cc:sysmt+15,1,1,"@":x=1:y=1:g=1
240 sysmt+42,"[157][145]m [160]^"+chr$(20)+"123456789[147]fogcbrvsq"
250 geta$:onval(a$)goto300,280,340,320,540,360,360,1270,560:a=asc(a$)-48
260 ona-9goto740,750,760,770,780,790,800,810,820,920,990,830,850,870,890,1120
270 ona-25goto1140,1150,2270
280 sysmt+9,208:x=x+1:ifx>mthenx=1:y=y+1:ify>mtheny=1
290 poke646,cc:sysmt+15,x,y,"@":goto240
300 sysmt+9,208:x=x-1:ifx<1thenx=m:y=y-1:ify<1theny=m
310 poke646,cc:sysmt+15,x,y,"@":goto240
320 sysmt+9,208:y=y+1:ify>mtheny=1:x=x+1:ifx>mthenx=1
330 poke646,cc:sysmt+15,x,y,"@":goto240
340 sysmt+9,208:y=y-1:ify<1theny=m:x=x-1:ifx<1thenx=m
350 poke646,cc:sysmt+15,x,y,"@":goto240
360 poke646,tc:sysmt+15,x,y,"@":sysmt+6,208:onm/8goto370,380,430
370 pokeft+246*8+y-1,peek(ft+246*8+y-1)or2^(8-x):goto280
380 ify>8then410
390 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)or2^(8-x):goto280
400 pokeft+247*8+y-1,peek(ft+247*8+y-1)or2^(16-x):goto280
410 ifx<9thenpokeft+248*8+y-9,peek(ft+248*8+y-9)or2^(8-x):goto280
420 pokeft+249*8+y-9,peek(ft+249*8+y-9)or2^(16-x):goto280
430 ify>8then470
440 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)or2^(8-x):goto280
450 ifx<17thenpokeft+247*8+y-1,peek(ft+247*8+y-1)or2^(16-x):goto280
460 pokeft+248*8+y-1,peek(ft+248*8+y-1)or2^(24-x):goto280
470 ify>16then510
480 ifx<9thenpokeft+249*8+y-9,peek(ft+249*8+y-9)or2^(8-x):goto280
490 ifx<17thenpokeft+250*8+y-9,peek(ft+250*8+y-9)or2^(16-x):goto280
500 pokeft+251*8+y-9,peek(ft+251*8+y-9)or2^(24-x):goto280
510 ifx<9thenpokeft+252*8+y-17,peek(ft+252*8+y-17)or2^(8-x):goto280
520 ifx<17thenpokeft+253*8+y-17,peek(ft+253*8+y-17)or2^(16-x):goto280
530 pokeft+254*8+y-17,peek(ft+254*8+y-17)or2^(24-x):goto280
540 print"[147]":sysmt+12:m=m+8:ifm>24thenm=8
550 goto200
560 poke646,gc:sysmt+15,x,y,"[146]@":sysmt+6,208:onm/8goto570,580,630
570 pokeft+246*8+y-1,peek(ft+246*8+y-1)and(255-2^(8-x)):goto300
580 ify>8then610
590 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)and(255-2^(8-x)):goto300
600 pokeft+247*8+y-1,peek(ft+247*8+y-1)and(255-2^(16-x)):goto300
610 ifx<9thenpokeft+248*8+y-9,peek(ft+248*8+y-9)and(255-2^(8-x)):goto300
620 pokeft+249*8+y-9,peek(ft+249*8+y-9)and(255-2^(16-x)):goto300
630 ify>8then670
640 ifx<9thenpokeft+246*8+y-1,peek(ft+246*8+y-1)and(255-2^(8-x)):goto300
650 ifx<17thenpokeft+247*8+y-1,peek(ft+247*8+y-1)and(255-2^(16-x)):goto300
660 pokeft+248*8+y-1,peek(ft+248*8+y-1)and(255-2^(24-x)):goto300
670 ify>16then710
680 ifx<9thenpokeft+249*8+y-9,peek(ft+249*8+y-9)and(255-2^(8-x)):goto300
690 ifx<17thenpokeft+250*8+y-9,peek(ft+250*8+y-9)and(255-2^(16-x)):goto300
700 pokeft+251*8+y-9,peek(ft+251*8+y-9)and(255-2^(24-x)):goto300
710 ifx<9thenpokeft+252*8+y-17,peek(ft+252*8+y-17)and(255-2^(8-x)):goto300
720 ifx<17thenpokeft+253*8+y-17,peek(ft+253*8+y-17)and(255-2^(16-x)):goto300
730 pokeft+254*8+y-17,peek(ft+254*8+y-17)and(255-2^(24-x)):goto300
740 c=(c+1)and15:goto200
750 c2=(c2+1)and15:goto200
760 c3=(c3+1)and15:goto200
770 c4=(c4+1)and15:goto200
780 c5=(c5+1)and15:goto200
790 c6=(c6+1)and15:goto200
800 c7=(c7+1)and15:goto200
810 c8=(c8+1)and15:goto200
820 c9=(c9+1)and15:goto200
830 tc=(tc+1)and15:iftc=(peek(53281)and15)then830
840 goto220
850 gc=(gc+1)and15:ifgc=(peek(53281)and15)then850
860 goto220
870 cc=(cc+1)and15:ifcc=(peek(53281)and15)then870
880 poke646,cc:sysmt+15,x,y,"@":goto240
890 bc=(bc+1)and15:ifbc=tcorbc=gcorbc=ccthen890
900 poke53281,bc:poke53280,bc:goto240
910 rem clear grids
920 ms$="[195]lear [199]rid? [193]re [217]ou [211]ure? ([217]/[206])":gosub1050:geta$
930 ifa$<>"y"then240
940 onm/8goto950,960,970
950 fori=ft+246*8toft+246*8+7:pokei,0:next:goto220
960 fori=ft+246*8toft+249*8+7:pokei,0:next:goto220
970 fori=ft+246*8toft+254*8+7:pokei,0:next:goto220
980 rem fill grids
990 ms$="[198]ill [199]rid? [193]re [217]ou [211]ure? ([217]/[206])":gosub1050:geta$
1000 ifa$<>"y"then240
1010 onm/8goto1020,1030,1040
1020 fori=ft+246*8toft+246*8+7:pokei,255:next:goto220
1030 fori=ft+246*8toft+249*8+7:pokei,255:next:goto220
1040 fori=ft+246*8toft+254*8+7:pokei,255:next:goto220
1050 ifpeek(787)<>255thensysmt+6,216
1060 sysmt+3,2,38,12,16,255,gc:poke199,1
1070 sysmt+3,1,37,11,15,160,tc:poke646,tc:sysmt+18,13,ms$
1080 ifpeek(787)=255thenpoke787,0:return
1090 poke198,0:wait198,15
1100 sysmt+9,216:return
1110 rem reverse
1120 sys51459,m:goto220
1130 rem show screen
1140 sysmt+6,216:gosub1220:poke198,0:wait198,15:geta$:sysmt+9,216:goto240
1150 sysmt+6,216:sysmt+3,22,33,1,11,160,tc:print"";:poke646,tc
1160 sysmt+18,24," [208]lease [211]elect [211]torage [211]lot ":poke646,tc
1170 fori=1to10:sysmt+15,23,i,"[211]lot"+str$(i):next:sysmt+15,23,i,dm$(7)
1180 sysmt,1,22,33,11,tc,gc,0:sysmt+6,232:sysmt+9,216:geta$
1182 ifa$=";"thensysmt+9,208:goto240
1185 a=asc(a$)-48:sb=bs+72*(a-1)
1190 a=ft+246*8:fori=0to71:aa=peek(sb+i):pokesb+i,peek(a+i):pokea+i,aa:next
1200 goto200
1210 rem screen fill
1220 ifm=8thensysmt+3,0,39,0,24,246,c
1230 ifm=16thensysmt+36,246,247,248,249,c,c2,c3,c4
1240 ifm=24thensysl+39,246,247,248,249,250,251,252,253,254,c,c2,c3,c4,c5,c6,c7,c8,c9
1250 return
1260 rem menus
1270 sysmt+6,216:poke646,tc:print" [196]isk [199]rid [212]iles [209]uadrant [195]olors "
1280 sysmt+18,24," [211][208][193][195][197] [212]o [211]witch [194]etween [205]enus ":poke646,gc:sysmt+6,224
1290 mu=1:sysmt+3,1,15,1,9,160,gc:print"";
1300 fori=1to6:sysmt+15,2,i,dm$(i):next
1310 sysmt+15,2,i,"[196]evice [206]umber":sysmt+15,2,i+1,dm$(7)
1320 sysmt+15,2,i+2,"[204][207][193][196][211][212][193][210]"
1330 sysmt,1,1,15,9,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifval(a$)=0then1350
1340 onval(a$)goto1680,1780,1900,1960,2020,2080,2100,240,2270
1350 mu=2:sysmt+9,224:sysmt+3,8,29,1,8,160,gc:print"";:poke646,gc
1360 fori=1to7:sysmt+15,9,i,gm$(i):next:sysmt+15,9,i,dm$(7)
1370 sysmt,1,8,29,8,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifval(a$)=0then1460
1380 onval(a$)goto1390,1400,1410,1420,1430,1440,1450,240
1390 m=24:goto540
1400 m=8:goto540
1410 m=16:goto540
1420 gosub1640:gc=co:goto220
1430 gosub1640:tc=co:goto220
1440 gosub1640:cc=co:goto220
1450 gosub1640:bc=co:poke53280,bc:poke53281,bc:goto240
1460 mu=3:sysmt+9,224:sysmt+3,15,34,1,5,160,gc:print"";:poke646,gc
1470 fori=1to4:sysmt+15,16,i,tm$(i):next:sysmt+15,16,i,dm$(7)
1480 sysmt,1,15,34,5,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifval(a$)=0then1510
1490 onval(a$)goto1140,920,1120,1500,240
1500 sysmt+9,232:sysmt+3,0,39,24,24,32,0:goto1150
1510 mu=4:sysmt+9,224:sysmt+3,22,33,1,10,160,gc:print"";:poke646,gc
1520 fori=1to9:sysmt+15,23,i,"[209]uadrant"+str$(i):next:sysmt+15,23,i,dm$(7)
1530 sysmt,1,22,33,10,gc,tc,32:sysmt+6,232:sysmt+9,216:geta$:ifa$=""then1270
1535 a=asc(a$)-48
1540 onagoto1550,1560,1570,1580,1590,1600,1610,1620,1630,240
1550 co=c:gosub1640:c=co:goto200
1560 co=c2:gosub1640:c2=co:goto200
1570 co=c3:gosub1640:c3=co:goto200
1580 co=c4:gosub1640:c4=co:goto200
1590 co=c5:gosub1640:c5=co:goto200
1600 co=c6:gosub1640:c6=co:goto200
1610 co=c7:gosub1640:c7=co:goto200
1620 co=c8:gosub1640:c8=co:goto200
1630 co=c9:gosub1640:c9=co:goto200
1640 sysmt+9,232:sysmt+3,0,39,24,24,32,0
1650 sysmt+3,12,24,2,17,160,tc:poke646,tc:poke199,1
1660 fori=1to16:sysmt+15,13,i+1,c$(i):next
1670 sysmt,2,12,24,16,tc,cc,0:getc$:co=asc(c$)-49
1675 sysmt+9,216:return
1680 ms$="[208]lease [197]nter [198]ont [206]ame":poke787,255:gosub1050:sysmt+3,1,37,16,16,99,tc
1690 sysmt+3,3,36,15,15,32,gc:sysmt+15,1,15,"":sys9*4096,tc,gc,34
1700 ifw$=""thensysmt+9,216:goto240
1710 ms$="[206]ew [204]oad [193]ddress?":poke787,255:gosu